home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swaga_c.zip / ARCHIVES.SWG / 0019_Zip File Viewer.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-26  |  6KB  |  261 lines
  1. unit ZipView;
  2.  
  3. interface
  4. uses dos;
  5.  
  6. type
  7.  barray= array[1..8192] of byte;
  8.  ZipPtr=^ZipRec;
  9.  ZipRec= Record
  10.           version_made: word;
  11.           version_extr: word;
  12.           flags: word;
  13.           comp_method: word;
  14.           last_mod_time: word;
  15.           last_mod_date: word;
  16.           crc_32: longint;
  17.           compressed_size: longint;
  18.           uncompressed_size: longint;
  19.           fname_length: word;
  20.           extra_length: word;
  21.           comment_length: word;
  22.           disk_num_start: word;
  23.           internal_attr: word;
  24.           external_attr: longint;
  25.           rel_ofs: longint;
  26.           name: string[12];
  27.           Next: ZipPtr;
  28.          end;
  29.  bptr = ^barray;
  30. const
  31.  ZipMethod: array[0..9] of string[15] =
  32.            ('stored   ',          'shrunk   ',       'reduced-1',
  33.             'reduced-2',          'reduced-3',       'reduced-4',
  34.             'imploded ',          'unknown  ',       'unknown  ',
  35.             'unknown  ');
  36.  
  37. var
  38.  totallength,totalsize,numfiles: longint;
  39.  firstzip: zipptr;
  40.  lineout: string;
  41.  outPtr: pointer;
  42.  
  43. procedure LoadZip(filename: string);
  44. procedure DisplayZip;
  45. procedure DisposeZip;
  46.  
  47. implementation
  48.  
  49. var
  50.  f: file of barray;
  51.  buffer: barray;
  52.  addr: longint;
  53.  bufptr: word;
  54.  
  55. {$F+}
  56. Procedure CallProc;
  57. inline($FF/$1E/OutPtr);
  58. {$F-}
  59.  
  60. Function NextByte: byte;
  61. var i: integer;
  62. begin;
  63.  inc(addr);
  64.  inc(bufptr);
  65.  if bufptr=8193 then begin;
  66.   {$I-}
  67.   read(f,buffer);
  68.   {$I+}
  69.   i:=ioresult;
  70.   bufptr:=1;
  71.  end;
  72.  nextbyte:=buffer[bufptr];
  73. end;
  74.  
  75. procedure LoadZip(filename: string);
  76. var
  77.  b: byte;
  78.  f2: file of byte;
  79.  fs: longint;
  80.  LastZip,Zip: ZipPtr;
  81.  Bytes: Bptr absolute zip;
  82.  a: integer;
  83.  sr: searchrec;
  84. begin;
  85.  firstzip:=nil;
  86. { assign(f2,filename);
  87.  reset(F2);
  88.  fs:=filesize(f2);
  89.  close(f2);}
  90.  findfirst(filename,anyfile,sr);
  91.  fs:=sr.size;
  92.  assign(f,filename);
  93.  reset(f);
  94.  addr:=0;
  95.  if fs>65535 then begin;
  96.   seek(f,(fs div 8192)-4);
  97.   addr:=addr+((fs div 8192)-4)*8192;
  98.  end;
  99.  {$I-}
  100.  read(f,buffer);
  101.  {$I+}
  102.  a:=ioresult;
  103.  bufptr:=0;
  104.  b:=nextbyte;
  105.  repeat;
  106.   if b=$50 then begin;
  107.    b:=nextbyte;
  108.    if b=$4b then begin;
  109.     b:=nextbyte;
  110.     if b=$01 then begin;
  111.      b:=nextbyte;
  112.      if b=$02 then begin;
  113.       new(zip);
  114.       zip^.next:=nil;
  115.       if firstzip=nil then firstzip:=zip else lastzip^.next:=zip;
  116.       lastzip:=zip;
  117.       for a:=1 to 42 do bytes^[a]:=nextbyte;
  118.       zip^.name:='';
  119.       for a:=1 to zip^.fname_length do zip^.name:=zip^.name+chr(nextbyte);
  120.       b:=nextbyte;
  121.      end;
  122.     end;
  123.    end;
  124.   end else b:=nextbyte;
  125.  until addr>=fs;
  126. end;
  127.  
  128. procedure OutLine(s: string);
  129. begin;
  130.  lineout:=s;
  131.  if OutPtr=NIL then writeln(s) else CallProc;
  132. end;
  133.  
  134. function format_date(date: word): string;
  135. var
  136.  s,s2: string;
  137.  y,m,d: word;
  138. begin
  139.  m:=(date shr 5) and 15;
  140.  d:=( (date      ) and 31);
  141.  y:=(((date shr 9) and 127)+80);
  142.  str(m,s);
  143.  while length(s)<2 do s:='0'+s;
  144.  s:=s+'-';
  145.  str(d,s2);
  146.  while length(s2)<2 do s2:='0'+s2;
  147.  s:=s+s2+'-';
  148.  str(y,s2);
  149.  while length(s2)<2 do s2:='0'+s2;
  150.  s:=s+s2;
  151.  format_date:=s;
  152. end;
  153.  
  154. function format_time(time: word): string;
  155. var
  156.  s,s2: string;
  157.  h,m,se: word;
  158. begin
  159.  h:=(time shr 11) and 31;
  160.  m:=(time shr  5) and 63;
  161.  se:=(time shl  1) and 63;
  162.  str(h,s);
  163.  while length(S)<2 do s:='0'+s;
  164.  s:=s+':';
  165.  str(m,s2);
  166.  while length(s2)<2 do s2:='0'+s2;
  167.  s:=s+s2;
  168.  format_time:=s;
  169. end;
  170.  
  171. procedure DisplayHeader;
  172. begin;
  173.  OutLine('Filename      Length   Size     Method     Date      Time   Ratio');
  174.  OutLine('------------  -------  -------  ---------  --------  -----  -----');
  175. end;
  176.  
  177. procedure DisplayFooter;
  178. var
  179.  s,s2: string;
  180.  average: real;
  181. begin;
  182.  OutLine('------------  -------  -------                              -----');
  183.  average:=100-totalsize/totallength*100;
  184.  str(numfiles:12,s);
  185.  str(totallength:7,s2);
  186.  s:=s+'  '+s2+'  ';
  187.  str(totalsize:7,s2);
  188.  s:=s+s2+'                              ';
  189.  str(average:4:0,s2);
  190.  s:=s+s2+'%';
  191.  outline(s);
  192. end;
  193.  
  194. procedure DisplayZip;
  195. var
  196.  curzip: zipptr;
  197.  s,s2: string;
  198. begin;
  199.  numfiles:=0;
  200.  totallength:=0;
  201.  totalsize:=0;
  202.  DisplayHeader;
  203.  curzip:=firstzip;
  204.  while curzip<>nil do begin;
  205.   s:=curzip^.name;
  206.   while length(s)<14 do s:=s+' ';
  207.   str(curzip^.uncompressed_size,s2);
  208.   while length(s2)<7 do s2:=' '+s2;
  209.   s:=s+s2+'  ';
  210.   str(curzip^.compressed_size,s2);
  211.   while length(s2)<7 do s2:=' '+s2;
  212.   s:=s+s2+'  ';
  213.   s:=s+ZipMethod[curzip^.comp_method]+'  ';
  214.   s:=s+format_date(curzip^.last_mod_date)+'  '+format_time(curzip^.last_mod_time)+'  ';
  215.   str(100-curzip^.compressed_size/curzip^.uncompressed_size*100:1:1,s2);
  216.   s2:=s2+'%';
  217.   while length(s2)<5 do s2:=' '+s2;
  218.   s:=s+s2;
  219.   Outline(s);
  220.   totallength:=totallength+curzip^.uncompressed_size;
  221.   totalsize:=totalsize+curzip^.compressed_size;
  222.   inc(numfiles);
  223.   curzip:=curzip^.next;
  224.  end;
  225.  if (numfiles=0) or (totallength=0) or (totalsize=0) then begin;
  226.   outline('No valid file entries detected.');
  227.  end else begin;
  228.   displayfooter;
  229.  end;
  230. end;
  231.  
  232. procedure DisposeZip;
  233. var
  234.  curzip,savezip: zipptr;
  235. begin;
  236.  curzip:=firstzip;
  237.  while curzip<>nil do begin;
  238.   savezip:=curzip^.next;
  239.   dispose(curzip);
  240.   curzip:=savezip;
  241.  end;
  242. end;
  243.  
  244. begin;
  245.  OutPtr:=Nil;
  246. end.
  247.  
  248. { --------------------------   CUT HERE -----------------------------}
  249. { TEST PROGRAM }
  250.  
  251. uses zipview;
  252.  
  253. var
  254.  s: string;
  255. begin;
  256.  write('File to Zip-View ? ');
  257.  readln(s);
  258.  LoadZip(s);
  259.  DisplayZip;
  260.  DisposeZip;
  261. end.